unit RegTools;

interface

uses
  Windows, Classes, Registry;

type
  TWhenStartupProgram = (wspWin9XStartup, wspAnyLogsOn, wspUsrLogsOn);

function AddRegistryString( RootKey: HKey; const Key, Name, Value: string; CanCreateKey:boolean=true ): boolean;
function GetRegistryString( RootKey: HKey; const Key, Name: string ): string;
function DelRegistryString( RootKey: HKey; const Key, Name: string ): boolean;

function StrToRootKey( s: string ): HKey;
function StrToKey( s: string; var Root: HKey; var Key: string ): boolean;

function ImportRegistryFile( const fn: string; params: TStrings ): boolean;
procedure DeleteRegistryKey( const key: string );

function RegisterServiceWin9X( const ServiceName, Command: string ): boolean;
function RegisterStartupProgram( const Name, Command: string; When: TWhenStartupProgram;
                                 OnlyOnce: boolean= false ): boolean;
function UnregisterServiceWin9X( const ServiceName: string ): boolean;
function UnregisterStartupProgram( const Name: string; When: TWhenStartupProgram;
                                   OnlyOnce: boolean= false ): boolean;
function GetStartupProgramCommand( const Name: string; When: TWhenStartupProgram; OnlyOnce: boolean= false ): string;
function GetStartupProgramList( When: TWhenStartupProgram; List: TStrings; OnlyOnce: boolean= false ): boolean;

implementation

uses
  SysUtils, StrTools;

const
  KeyCurrVer = '\SOFTWARE\Microsoft\Windows\CurrentVersion\';

resourcestring
  rsErrorNoWin9X = 'This function must be used only in Windows 9X';

function StrToRootKey( s: string ): HKey;
begin
  s := UpperCase(Trim(s));
  if      s='HKEY_CLASSES_ROOT'   then result := HKEY_CLASSES_ROOT
  else if s='HKEY_CURRENT_USER'   then result := HKEY_CURRENT_USER
  else if s='HKEY_LOCAL_MACHINE'  then result := HKEY_LOCAL_MACHINE
  else if s='HKEY_USERS'          then result := HKEY_USERS
  else if s='HKEY_CURRENT_CONFIG' then result := HKEY_CURRENT_CONFIG
  else if s='HKEY_DYN_DATA'       then result := HKEY_DYN_DATA
  else                                 result := 0;
end;

function StrToKey( s: string; var Root: HKey; var Key: string ): boolean;
begin
  Root := StrToRootKey(GetParam('\',s));
  Key := '\'+s;
  result := Root<>0;
end;

function ImportRegistryFile( const fn: string; params: TStrings ): boolean;
var
  t    : TextFile;
  l,n  : string;
  r    : TRegistry;
  modo : (modoClave,modoValor);
  fin  : boolean;
  function SacarComillas( s: string ): string;
  begin
    s := Trim(s);
    if (s>'') and (s[1]='"') and (s[length(s)]='"') then
      result := copy(s,2,length(s)-2)
    else
      result := s;
  end;
  function SacarCorchetes( s: string ): string;
  begin
    s := Trim(s);
    if (s>'') and (s[1]='[') and (s[length(s)]=']') then
      result := copy(s,2,length(s)-2)
    else
      result := s;
  end;
  function ReadLine( var l: string ): boolean;
  begin
    repeat
      result := not EOF(t);
      if not result then exit;
      readln(t,l);
      l := Trim(l);
    until l>'';
    l := ReplaceParams(l,params);
  end;
begin
  result := false;
  try
    r := TRegistry.Create;
    assign(t,fn);
    Reset(t);
    if not ReadLine(l) or (UpperCase(l)<>'REGEDIT4') then exit;
    modo := modoClave;
    fin  := not ReadLine(l);
    result := true;
    while not fin and result do
    begin
      case modo of
        modoClave:
          if l[1]='[' then
          begin
            l := SacarCorchetes(l);
            r.CloseKey;
            r.RootKey := StrToRootKey(GetParam('\',l));
            result := r.OpenKey('\'+l,true);
            fin := not ReadLine(l);
            modo := modoValor;
          end
          else result := false;
        modoValor:
          if l[1]='"' then
          begin
            n := SacarComillas(GetParam('=',l));
            // if n='@' then n := '';
            r.WriteString(n,SacarComillas(l));
            fin := not ReadLine(l);
          end
          else if l[1]='@' then
          begin
            GetParam('=',l);
            r.WriteString('',SacarComillas(l));
            fin := not ReadLine(l);
          end
          else if l[1]='[' then
            modo := modoClave;
          else result := false;
      end;
    end;
    Close(t);
    r.CloseKey;
  except
    r.Free;
  end;
end;

procedure DeleteRegistryKey( const key: string );
var
  r : TRegistry;
  k : string;
  procedure DeleteKey( k: string );
  var
    kn : TStringList;
    i  : integer;
  begin
    if not r.OpenKey(k,false) then exit;
    if r.HasSubKeys then
    begin
      kn := TStringList.Create;
      r.GetKeyNames(kn);
      r.CloseKey;
      for i := 0 to kn.Count-1 do
        DeleteKey(k+'\'+kn[i]);
      kn.Free;
    end
    else r.CloseKey;
    r.DeleteKey(k);
  end;
begin
  k := Key;
  r := TRegistry.Create;
  r.RootKey := StrToRootKey(GetParam('\',k));
  DeleteKey(k);
  r.Free;
end;

function AddRegistryString( RootKey: HKey; const Key, Name, Value: string; CanCreateKey:boolean=true ): boolean;
var
  r : TRegistry;
begin
  result := false;
  r := TRegistry.Create;
  r.RootKey := RootKey;
  if r.OpenKey(Key,CanCreateKey) then
  begin
    r.WriteString(Name,Value);
    result := true;
  end;
  r.Free;
end;

function GetRegistryString( RootKey: HKey; const Key, Name: string ): string;
var
  r : TRegistry;
begin
  result := '';
  r := TRegistry.Create;
  r.RootKey := RootKey;
  if r.OpenKey(Key,false) then
    result := r.ReadString(Name);
  r.Free;
end;

function DelRegistryString( RootKey: HKey; const Key, Name: string ): boolean;
var
  r : TRegistry;
begin
  result := false;
  r := TRegistry.Create;
  r.RootKey := RootKey;
  if r.OpenKey(Key,false) then
    result := r.DeleteValue(Name);
  r.Free;
end;

function GetRegistryNames( RootKey: HKey; const Key: string; Names: TStrings ): boolean;
var
  r : TRegistry;
begin
  result := false;
  r := TRegistry.Create;
  r.RootKey := RootKey;
  if r.OpenKey(Key,false) then
  begin
    r.GetValueNames(Names);
    result := true;
  end;
  r.Free;
end;

function GetRegistryValues( RootKey: HKey; const Key: string; Values: TStrings ): boolean;
var
  r : TRegistry;
  n : TStringList;
  i : integer;
begin
  result := false;
  r := TRegistry.Create;
  r.RootKey := RootKey;
  if r.OpenKey(Key,false) then
  begin
    n := TStringList.Create;
    r.GetValueNames(n);
    for i := 0 to n.Count-1 do
      Values.Values[n[i]] := r.ReadString(n[i]);
    n.Free;
    result := true;
  end;
  r.Free;
end;

function RegisterServiceWin9X( const ServiceName, Command: string ): boolean;
begin
  if Win32Platform<>VER_PLATFORM_WIN32_WINDOWS then raise Exception.Create(rsErrorNoWin9X);
  result := AddRegistryString(HKEY_LOCAL_MACHINE,KeyCurrVer+'RunServices',ServiceName,Command);
end;

function UnregisterServiceWin9X( const ServiceName: string ): boolean;
begin
  if Win32Platform<>VER_PLATFORM_WIN32_WINDOWS then raise Exception.Create(rsErrorNoWin9X);
  result := DelRegistryString(HKEY_LOCAL_MACHINE,KeyCurrVer+'RunServices',ServiceName);
end;

procedure GetStartupProgramKey( When: TWhenStartupProgram; OnlyOnce: boolean;
                                var RootKey: HKEY; var Key: string );
begin
  case When of
    wspWin9XStartup:
      begin
        if Win32Platform<>VER_PLATFORM_WIN32_WINDOWS then raise Exception.Create(rsErrorNoWin9X);
        RootKey := HKEY_LOCAL_MACHINE;
        if OnlyOnce then Key := 'RunServicesOnce'
                    else Key := 'RunServices';
      end;
    wspAnyLogsOn:
      begin
        RootKey := HKEY_LOCAL_MACHINE;
        if OnlyOnce then Key := 'RunOnce'
                    else Key := 'Run';
      end;
    wspUsrLogsOn:
      begin
        RootKey := HKEY_CURRENT_USER;
        if OnlyOnce and (Win32Platform<>VER_PLATFORM_WIN32_WINDOWS) then raise Exception.Create(rsErrorNoWin9X);
        if OnlyOnce then Key := 'RunOnce'
                    else Key := 'Run';
      end;
  end;
end;

function RegisterStartupProgram( const Name, Command: string; When: TWhenStartupProgram;
                                 OnlyOnce: boolean= false ): boolean;
var
  rk : HKEY;
  k  : string;
begin
  GetStartupProgramKey(When,OnlyOnce,rk,k);
  result := AddRegistryString(rk,KeyCurrVer+k,Name,Command);
end;

function UnregisterStartupProgram( const Name: string; When: TWhenStartupProgram;
                                   OnlyOnce: boolean= false ): boolean;
var
  rk : HKEY;
  k  : string;
begin
  GetStartupProgramKey(When,OnlyOnce,rk,k);
  result := DelRegistryString(rk,KeyCurrVer+k,Name);
end;

function GetStartupProgramCommand( const Name: string; When: TWhenStartupProgram; OnlyOnce: boolean= false ): string;
var
  rk : HKEY;
  k  : string;
begin
  GetStartupProgramKey(When,OnlyOnce,rk,k);
  result := GetRegistryString(rk,KeyCurrVer+k,Name);
end;

function GetStartupProgramList( When: TWhenStartupProgram; List: TStrings; OnlyOnce: boolean= false ): boolean;
var
  rk : HKEY;
  k  : string;
begin
  GetStartupProgramKey(When,OnlyOnce,rk,k);
  result := GetRegistryValues(rk,KeyCurrVer+k,List);
end;

end.
